Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Libraries/SAT 2.4.0/SAT/Demo ƒ/HeartQuest demo ƒ/main.p

Text File | 1997-02-16 | 13.7 KB | 421 lines | [TEXT/PJMM]

{================================================}
{=============== HeartQuest main unit ================}
{================================================}

{ Example file for Ingemars Sprite Animation Toolkit. }
{ © Ingemar Ragnemalm 1992 }
{ See doc files for legal terms for using this code. }

{ HeartQuest is a very simple game demonstrating how to use the Sprite Animation}
{ Toolkit. I originally wrote the game as my present to my wife Eva for Valentine's}
{ day 1992. You can still tell that this file once started as the Skel example in the}
{ TransSkel package by Paul DuBois and Owen Hartnett. }

{ This "main" file is rather small, and holds very little game specific code.}
{ Its main concern is to initialize the various parts of the game, and to hold the}
{ file and edit menu handlers. }

program HeartQuest;

    uses
{$IFC UNDEFINED THINK_PASCAL}
        Types, Quickdraw, Events, Windows, Resources, Fonts, {}
        Menus, Memory, QuickDrawText, Errors, OSUtils, EPPC,
{$ENDC}
        TransSkel, SAT, GameGlobals, GameWindow, {sound,}
        SoundConst, scores, CenterStuff, Preferences, AppleEvents, ClutFade, SATSetDepth, sBonus;

{Variables for the main program}
    var
        keys: KeyMap;
        zoomFlag: Boolean;
        ignore: longint;                        {For UnloadScrap error}
        gAppleEventsInitialized: Boolean;    {For initializing Apple Events when necessary}

{ -------------------------------------------------------------------- }
{                        Menu handling procedures                        }
{ -------------------------------------------------------------------- }

{    Handle selection of "About…" item from Apple menu}

    procedure DoAbout;
        var
            selection: integer;
    begin
        selection := DoAlert(43, aboutAlrt, nil);
        if selection = 2 then
            selection := DoAlert(43, evaAlrt, nil);
    end;

{    Process selection from File menu.}

{    HelpEnemies    Shows a help box. }
{    Quit    Request a halt by calling SkelHalt().  This makes SkelMain}
{            return.}

    procedure DoFileMenu (item: integer);
        var
            ignore: integer;
    begin
        case item of
            fm_helpenemies:
                ignore := DoAlert(43, helpenemiesAlrt, nil);
            fm_setStrings:
                SetStrings;
            otherwise
                begin
                    if pauseFlag then
                        DoGameOver;
                    SkelWhoa;
                end;
        end;
    end; {DoFileMenu}

    procedure DoEditMenu;
    begin
    end;

{    Initialize menus.  Tell TransSkel to process the Apple menu}
{    automatically, and associate the proper procedures with the}
{    File and Edit menus.}

    procedure SetUpMenus;
    begin
        SkelApple(MyGetIndString(aboutStrID), @DoAbout); {string 1: About HeartQuest…}
        fileMenu := GetMenu(fileMenuRes);
        editMenu := GetMenu(editMenuRes);
        GameMenu := GetMenu(GameMenuRes);
        highMenu := GetMenu(highMenuRes);
        dummy := SkelMenu(fileMenu, @DoFileMenu, nil, false);
        dummy := SkelMenu(editMenu, @DoEditMenu, nil, false);
        dummy := SkelMenu(GameMenu, @DoGameMenu, nil, false);
        dummy := SkelMenu(highMenu, @DoHighMenu, nil, true);
    end;

{ Initialize settings resources. These are saved in the game file itself. This is elegant,}
{ but a bit "server-hostile". An alternative is to create a preference file in the system}
{ folder. The routine determining where preferences should be saved, in Preferences.p,}
{ has a parameter that can be set to always save in a preference file, if you prefer that.}

    procedure InitSettings;
    begin
        UseResFile(gPrefFile); {set the resfile to the pref file, if any. If none, gPrefFile will be the app itself!}
        features := featHnd(GetResource('Feat', 0));        { Load the settings }
        if features = nil then                                { Settings doesn't exist; create new }
            begin
                features := featHnd(NewHandle(Sizeof(featRec)));
                CheckNoMem(Ptr(features));
                features^^.sound := true;
                features^^.allowBG := false;
                features^^.player := MyGetIndString(anonymousStrID); {str 2: Anonymous}
                features^^.macho := false;
                features^^.sweetString1 := 'Eva';
                features^^.sweetString2 := 'är söt';
                AddResource(handle(features), 'Feat', 0, 'Settings');
            end
        else                                                    {Did exist - check the size!}
            if GetHandleSize(Handle(features)) < SizeOf(FeatRec) then
                begin
                    SetHandleSize(Handle(features), SizeOf(FeatRec));
{These are likely not to be in too small feature records:}
                    features^^.sweetString1 := 'Eva';
                    features^^.sweetString2 := 'är söt';
                end;
        UseResFile(gAppFile);

{ Fix all checkmarks in the menus }
        if features^^.sound then
            begin
                features^^.sound := false;
                DoGameMenu(sound);
            end
        else
            begin
                features^^.sound := true;
                DoGameMenu(sound);
            end;
        if features^^.macho then
            begin
                features^^.macho := false;
                DoGameMenu(macho);
            end
        else
            begin
                features^^.macho := true;
                DoGameMenu(macho);
            end;
        if features^^.PlotFast then
            begin
                features^^.PlotFast := false;
                DoGameMenu(FastAnimation);
            end
        else
            begin
                features^^.PlotFast := true;
                DoGameMenu(FastAnimation);
            end;
        if features^^.allowBG then
            begin
                features^^.allowBG := false;
                DoGameMenu(allowBG);
            end
        else
            begin
                features^^.allowBG := true;
                DoGameMenu(allowBG);
            end;
    end;


{ ******* MultiFinder and Apple events: ******* }

{MultiFinder events - suspend and reume - have been handled by HeartQuest since very early versions,}
{since I want it to hide its window when switched out.}
{AppleEvents are added, mostly because I wanted to learn about it. I learned one thing: Apple Events are}
{tedious. I tried simplifying AppleEvent support by installing my handlers first after getting an Apple}
{Event (getting rid of all checking for its existence - if it sends events to me, it exists) - but the interface}
{files needed are horrible. To speed up compilation, I made a stripped down interface file, HQAE.p.}
{All I really got by supporting Apple Events is that I can quit after getting the 'quit' Apple event.}

{Handle the required Apple events:}
{DoOpenApp,DoOpenDoc,DoPrintDoc,DoQuitApp}
{MyGotRequiredParams: From MSG demo my Mark Pilgrim, tells whether we have handled all we have to or not.}
    function MyGotRequiredParams (theAppleEvent: AppleEvent): OSErr;
        var
            returnedType: DescType;
            actualSize: Size;
    begin
        if AEGetAttributePtr(theAppleEvent, keyMissedKeywordAttr, typeWildCard, returnedType, nil, 0, actualSize) = errAEDescNotFound then
            MyGotRequiredParams := noErr
        else
            MyGotRequiredParams := errAEParamMissed;
    end;
    function DoOpenApp (theAppleEvent, reply: AppleEvent; refCon: Longint): OSErr;
    begin
{What am I supposed to do here?}
        DoOpenApp := MyGotRequiredParams(theAppleEvent);
    end;
    function DoOpenDoc (theAppleEvent, reply: AppleEvent; refCon: Longint): OSErr;
    begin
        DoOpenDoc := errAEEventNotHandled; {We don't open any documents!}
    end;
    function DoPrintDoc (theAppleEvent, reply: AppleEvent; refCon: Longint): OSErr;
    begin
        DoPrintDoc := errAEEventNotHandled; {We don't print any documents!}
    end;
    function DoQuitApp (theAppleEvent, reply: AppleEvent; refCon: Longint): OSErr;
    begin
        SkelWhoa;            {If I'm told to quit, I'll quit.}
        DoQuitApp := MyGotRequiredParams(theAppleEvent);
    end;

{Init Apple events}
{Perhaps I'm cheating, but I don't call this until I get the first Apple event.}
{IMHO, that's the simplest way to support them without a lot of boring Gestalt checks.}
    procedure AppleEventInit;
        var
            error: OSerr;
    begin
        if gAppleEventsInitialized then
            exit(AppleEventInit);
        gAppleEventsInitialized := true;
        error := AEInstallEventHandler(kCoreEventClass, kAEOpenApplication, @DoOpenApp, 0, false);
        error := AEInstallEventHandler(kCoreEventClass, kAEOpenDocuments, @DoOpenDoc, 0, false);
        error := AEInstallEventHandler(kCoreEventClass, kAEPrintDocuments, @DoPrintDoc, 0, false);
        error := AEInstallEventHandler(kCoreEventClass, kAEQuitApplication, @DoQuitApp, 0, false);
{I ignore errors.}
    end;


{Event processing that TransSkel nowadays HAS support for:}
{MultiFinder events: Hide gameWindow on suspend, so the user can get access to disk icons etc.}
{Apple Events: Handle the required Apple events.}

    procedure DoSuspendResume (b: Boolean);
    begin
        if b then
{Resume event: show game window and set the sleep time to something fairly low}
            begin
                ShowWindow(gSAT.wind.port);
                SelectWindow(gSAT.wind.port);
                SkelSetSleep(5);
            end
        else
{Suspend event: Hide the game window and set the sleep time to something high}
{(Not that the sleep time matters when "can background" is false, but I put it in for demonstrating it.)}
            begin
                HideWindow(gSAT.wind.port);
                SkelSetSleep(60);
            end;
    end;

    function DoEvt (e: eventRecord): boolean;
    begin
{In older versions, we handled Apple events and suspend/resume events here. Since then,}
{I have added support for them in TransSkel.p, so now this is only used for installing our}
{Apple Event handlers upon acceptance of the first Apple Event.}

{Old obsolete code: Handle suspend/resume events}
{if e.what = OSevt then}
{begin}
{if BAND(BROTL(e.message, 8), $FF) = SuspendResumeMessage then}
{DoSuspendResume(BAnd(e.message, 1) <> 0);}
{DoEvt := true;}
{end}
{else}

        DoEvt := false; {We never actually PROCESS any event here!}
        if e.what = kHighLevelEvent then
            if not gAppleEventsInitialized then {My little "cheat" into compatibility}
                AppleEventInit;
{if AEProcessAppleEvent(e) <> noErr then}
    end; { DoEvt }


    procedure EmergencyExit;
    begin
{Fade back in on emergency exits, so we don't leave the screen faded!}
        FadeScreen(1, false, fadeTo);
    end; {EmergencyExit}

    var
        loadWind: WindowPtr;

    procedure ShowLoadWind;
        var
            s: Str255;
            fontNum: Integer;
            world: SysEnvRec;
            tempColorFlag: Boolean;
            height, width: Integer;
    begin
        tempColorFlag := false;
        if noErr = SysEnvirons(1, world) then
            if world.hasColorQd then
                tempColorFlag := true;
{$IFC UNDEFINED THINK_PASCAL}
        if tempColorFlag then
            loadWind := NewCWindow(nil, qd.screenBits.bounds, '', true, plainDBox, WindowPtr(-1), false, 0)
        else
            loadWind := NewWindow(nil, qd.screenBits.bounds, '', true, plainDBox, WindowPtr(-1), false, 0);
{$ELSEC}
        if tempColorFlag then
            loadWind := NewCWindow(nil, screenBits.bounds, '', true, plainDBox, WindowPtr(-1), false, 0)
        else
            loadWind := NewWindow(nil, screenBits.bounds, '', true, plainDBox, WindowPtr(-1), false, 0);
{$ENDC}

{Up with the loading window and draw SOMETHING}
        SetPort(loadWind);
{Paint the window pink}
        if tempColorFlag then
            RGBForeColor(fadeTo);
        PaintRect(loadWind^.portRect);
{Select 24-point Geneva}
        TextSize(24);
        TextFace([bold]);
        GetFNum('Geneva', fontNum);
        TextFont(fontNum);
{Get the loading string and draw it}
        s := MyGetIndString(loadingStrID);
        height := loadWind^.portRect.bottom - loadWind^.portRect.top;
        width := loadWind^.portRect.right - loadWind^.portRect.left;
        MoveTo(width div 2 - StringWidth(s) div 2, height div 2);
        ForeColor(redColor);
        DrawString(s);
        ForeColor(blackColor);
    end; {ShowLoadWind}

{ -------------------------------------------------------------------- }
{                                    Main                                }
{ -------------------------------------------------------------------- }

    var
        r: Rect;

begin
    SkelInit(6, nil);                { initialize }
    SetUpMenus;                { install menu handlers }

    SetCursor(GetCursor(watchCursor)^^);

{Using the SATSetDepth unit, I switch to 256 colors if available. If not, just leave it.}
    if SATHasDepth(nil, 8) then
        if noErr = SATSetDepth(nil, 8) then
            ;

{Is the user holding down a modifier key? If so, we should use the whole screen.}
    GetKeys(keys);
    zoomFlag := keys[55] or keys[56] or keys[58] or keys[59]; {cmd, shift, alt, ctrl}

{Tell SAT that we want it to rescale the PICTs}
    SATConfigure(true, kVPositionSort, kKindCollision, 32);

{Send strings from resources to SAT, so the program can be localized.}
    SATSetStrings(MyGetIndString(okStrID), MyGetIndString(yesStrID), MyGetIndString(noStrID), MyGetIndString(quitStrID), MyGetIndString(memerrStrID), MyGetIndString(noscreenStrID), MyGetIndString(satnopictStrID), MyGetIndString(nowindStrID));

{Before fading, set the emergency exit routine to one where we restore the screen!}
    SATInstallEmergency(@EmergencyExit);

    fadeTo.red := -1;
    fadeTo.green := 26214; {Was $a000}
    fadeTo.blue := -1; {was $a000}
    FadeScreen(30, true, fadeTo);
    ShowLoadWind;
    FadeScreen(30, false, fadeTo);

{ Set the randseed to something that is random enough. }
{$IFC UNDEFINED THINK_PASCAL}
    qd.randSeed := TickCount;
{$ELSEC}
    randSeed := TickCount;
{$ENDC}

{ Initialize the Sprite Animation Toolkit, set up offscreen buffers and make the window. }

    if zoomFlag then {if cmd, shift, alt, ctrl}
        SetRect(r, 0, 0, 32000, 32000) {Very big - makes SAT cut it down to the main screen.}
    else
        SetRect(r, 0, 0, 640, 480); {Standard size}
{We now prefer 640x480. Older versions used 512x342, but that is a bit too small to use as}
{preferred size these days.}

{No pictures here. We load them in DrawBackground. You can do the same and use patterns or}
{whatever you like, or do it the easy way and have it done with SATInit.}
    SATCustomInit(0, 0, r, nil, nil, true, true, true, true, true);

{Here we can call SATSoundInitChannels if we want more than one channel.}
    if SATSoundInitChannels(2) < 2 then
        ;
    SATPreloadChannels;

    Loadsounds;        { preload all sound resources }
    InitScores;        { Init the score module, check if a pref file should be created }
    InitSettings;    { Load the settings }

{ Init all the different parts of the game. }
    GameWindInit;    { Init the game window }

{ Initialize the sprites }
    InitSprites;
{We draw some of the background -the trees - ourselves in this game.}
    DrawBackground;

    FadeScreen(30, true, fadeTo);
{ Draw the contents of the window (to give the user something to look at during the rest of startup). }
    DisposeWindow(loadWind);
    ShowWindow(gSAT.wind.port);
    SelectWindow(gSAT.wind.port);
    HQRedraw;
    FadeScreen(30, false, fadeTo);

    SkelEventHook(@DoEvt); { handle MultiFinder-events }
    SkelSetSuspendResume(@DoSuspendResume); {NEW call in my version of TransSkel 2.0}
    InitCursor;

    SkelMain;                { loop 'til Quit selected }
    SkelClobber;                { clean up }
    SATSoundShutUp;            { Terminate sounds }

    SATRestoreDepth;
end.